home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / Tie / Hash.pm next >
Encoding:
Perl POD Document  |  1999-12-28  |  3.8 KB  |  154 lines
  1. package Tie::Hash;
  2.  
  3. =head1 NAME
  4.  
  5. Tie::Hash, Tie::StdHash - base class definitions for tied hashes
  6.  
  7. =head1 SYNOPSIS
  8.  
  9.     package NewHash;
  10.     require Tie::Hash;
  11.     
  12.     @ISA = (Tie::Hash);
  13.     
  14.     sub DELETE { ... }        # Provides needed method
  15.     sub CLEAR { ... }        # Overrides inherited method
  16.     
  17.     
  18.     package NewStdHash;
  19.     require Tie::Hash;
  20.     
  21.     @ISA = (Tie::StdHash);
  22.     
  23.     sub DELETE { ... }
  24.     
  25.     
  26.     package main;
  27.     
  28.     tie %new_hash, 'NewHash';
  29.     tie %new_std_hash, 'NewStdHash';
  30.  
  31. =head1 DESCRIPTION
  32.  
  33. This module provides some skeletal methods for hash-tying classes. See
  34. L<perltie> for a list of the functions required in order to tie a hash
  35. to a package. The basic B<Tie::Hash> package provides a C<new> method, as well
  36. as methods C<TIEHASH>, C<EXISTS> and C<CLEAR>. The B<Tie::StdHash> package
  37. provides most methods required for hashes in L<perltie>. It inherits from
  38. B<Tie::Hash>, and causes tied hashes to behave exactly like standard hashes,
  39. allowing for selective overloading of methods. The C<new> method is provided
  40. as grandfathering in the case a class forgets to include a C<TIEHASH> method.
  41.  
  42. For developers wishing to write their own tied hashes, the required methods
  43. are briefly defined below. See the L<perltie> section for more detailed
  44. descriptive, as well as example code:
  45.  
  46. =over
  47.  
  48. =item TIEHASH classname, LIST
  49.  
  50. The method invoked by the command C<tie %hash, classname>. Associates a new
  51. hash instance with the specified class. C<LIST> would represent additional
  52. arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
  53. complete the association.
  54.  
  55. =item STORE this, key, value
  56.  
  57. Store datum I<value> into I<key> for the tied hash I<this>.
  58.  
  59. =item FETCH this, key
  60.  
  61. Retrieve the datum in I<key> for the tied hash I<this>.
  62.  
  63. =item FIRSTKEY this
  64.  
  65. Return the (key, value) pair for the first key in the hash.
  66.  
  67. =item NEXTKEY this, lastkey
  68.  
  69. Return the next (key, value) pair for the hash.
  70.  
  71. =item EXISTS this, key
  72.  
  73. Verify that I<key> exists with the tied hash I<this>.
  74.  
  75. =item DELETE this, key
  76.  
  77. Delete the key I<key> from the tied hash I<this>.
  78.  
  79. =item CLEAR this
  80.  
  81. Clear all values from the tied hash I<this>.
  82.  
  83. =back
  84.  
  85. =head1 CAVEATS
  86.  
  87. The L<perltie> documentation includes a method called C<DESTROY> as
  88. a necessary method for tied hashes. Neither B<Tie::Hash> nor B<Tie::StdHash>
  89. define a default for this method. This is a standard for class packages,
  90. but may be omitted in favor of a simple default.
  91.  
  92. =head1 MORE INFORMATION
  93.  
  94. The packages relating to various DBM-related implemetations (F<DB_File>,
  95. F<NDBM_File>, etc.) show examples of general tied hashes, as does the
  96. L<Config> module. While these do not utilize B<Tie::Hash>, they serve as
  97. good working examples.
  98.  
  99. =cut
  100.  
  101. use Carp;
  102.  
  103. sub new {
  104.     my $pkg = shift;
  105.     $pkg->TIEHASH(@_);
  106. }
  107.  
  108.  
  109. sub TIEHASH {
  110.     my $pkg = shift;
  111.     if (defined &{"{$pkg}::new"}) {
  112.     carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing"
  113.         if $^W;
  114.     $pkg->new(@_);
  115.     }
  116.     else {
  117.     croak "$pkg doesn't define a TIEHASH method";
  118.     }
  119. }
  120.  
  121. sub EXISTS {
  122.     my $pkg = ref $_[0];
  123.     croak "$pkg doesn't define an EXISTS method";
  124. }
  125.  
  126. sub CLEAR {
  127.     my $self = shift;
  128.     my $key = $self->FIRSTKEY(@_);
  129.     my @keys;
  130.  
  131.     while (defined $key) {
  132.     push @keys, $key;
  133.     $key = $self->NEXTKEY(@_, $key);
  134.     }
  135.     foreach $key (@keys) {
  136.     $self->DELETE(@_, $key);
  137.     }
  138. }
  139.  
  140.  
  141. package Tie::StdHash;
  142. @ISA = qw(Tie::Hash);
  143.  
  144. sub TIEHASH  { bless {}, $_[0] }
  145. sub STORE    { $_[0]->{$_[1]} = $_[2] }
  146. sub FETCH    { $_[0]->{$_[1]} }
  147. sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
  148. sub NEXTKEY  { each %{$_[0]} }
  149. sub EXISTS   { exists $_[0]->{$_[1]} }
  150. sub DELETE   { delete $_[0]->{$_[1]} }
  151. sub CLEAR    { %{$_[0]} = () }
  152.  
  153. 1;
  154.